home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / LiPrgInt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-05  |  4.4 KB  |  160 lines
  1. // RTLI program interface
  2.  
  3. unit LIPrgInt;
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows;
  9.  
  10. type
  11.   PLocInfo = ^TLocInfo;
  12.   TLocInfo = record
  13.     liUnitName: String;
  14.     liUnitBegOfs: Integer;
  15.     liUnitEndOfs: Integer;
  16.     liLineOfs: Integer;
  17.     liLineNo: Integer;
  18.     liFileName: String;
  19.     liPubSym1Ofs: Longint;
  20.     liPubSym2Ofs: Longint;
  21.     liPubSym1Name: String;
  22.     liPubSym2Name: String;
  23.   end;
  24.  
  25. function GetLocationInfo(CodeAddr: Pointer; var LocInfo: TLocInfo): Boolean;
  26. function RTLIAvailable: Boolean;
  27. //procedure ___Fixup___;
  28.  
  29. implementation
  30.  
  31. uses LIUtils;
  32.  
  33. var
  34.   RTLIResPtr: Pointer = nil;
  35.   RTLIResInfo: HRSRC;
  36.   RTLIResource: THandle;
  37. const
  38.   LinkerOffset = $1000;
  39.  
  40. {procedure ___Fixup___;
  41. begin
  42. end;}
  43.  
  44. function RTLIAvailable: Boolean;
  45. begin
  46.   Result := Assigned(RTLIResPtr);
  47. end;
  48.  
  49. function GetLocationInfo(CodeAddr: Pointer; var LocInfo: TLocInfo): Boolean;
  50. var
  51.   P1,P2,P3: PChar;
  52.   CodeOfs: DWORD; // absolute CodeAddr;
  53.   OfsDelta: DWORD;
  54.   Count,Delta1,Delta2,CurOfs,CurLine: integer;
  55. begin
  56.   FillChar(LocInfo, SizeOf(TLocInfo), 0);
  57.   P1 := RTLIResPtr;
  58.   Result := Assigned(P1);
  59.   if Result then
  60.     with PRTLIHeader(P1)^, LocInfo do
  61.     begin
  62.       // This logic returns the wrong result some times.
  63. //      OfsDelta := Integer(@___Fixup___) - rtliFixup;
  64.       // Better to use HInstance (=$00400000 for EXE files) and the Borland
  65.       // linker offset ($1000)
  66.       OfsDelta := DWORD(HInstance) + LinkerOffset;
  67.       CodeOfs :=  DWORD(CodeAddr);
  68.       Dec(CodeOfs, OfsDelta);
  69.       Inc(P1, SizeOf(TRTLIHeader));
  70.       // Find the unit
  71.       Count := rtliUnitCount;
  72.       while Count > 0 do
  73.       begin
  74.         P2 := P1 + Ord(P1[4]) + 5;
  75.         if (CodeOfs >= DWORD(PDWord(P1)^)) and (CodeOfs < DWORD(PDWord(P2)^)) then
  76.         begin
  77.           DecodeString(liUnitName, P1 + 4);
  78.           liUnitBegOfs := integer(DWORD(PDWord(P1)^) + OfsDelta);
  79.           liUnitEndOfs := integer(DWORD(PDWord(P2)^) + OfsDelta);
  80.         end;
  81.         Dec(Count);
  82.         P1 := P2;
  83.       end;
  84.       Inc(P1, 4);   // Skip the ending offset
  85.       if liUnitName <> '' then
  86.       begin
  87.         // Find the public symbol
  88.         CurOfs := 0;
  89.         P3 := P1;
  90.         Count := rtliPublicCount;
  91.         while Count > 0 do
  92.         begin
  93.           P2 := DecodeSymbolOfs(P1 + Ord(P1^) + 1, Delta1);
  94.           P3 := DecodeSymbolOfs(P2 + Ord(P2^) + 1, Delta2);
  95.           if (CodeOfs >= DWORD(CurOfs + Delta1)) and (CodeOfs < DWORD(CurOfs + Delta1 + Delta2)) then
  96.           begin
  97.             liPubSym1Ofs := Integer(OfsDelta) + CurOfs + Delta1;
  98.             liPubSym2Ofs := liPubSym1Ofs + Delta2;
  99.             DecodeString(liPubSym1Name, P1);
  100.             DecodeString(liPubSym2Name, P2);
  101.           end;
  102.           P1 := P2;
  103.           Inc(CurOfs, Delta1);
  104.           Dec(Count);
  105.         end;
  106.         P1 := P3;
  107.         Count := rtliLineCount;
  108.         CurLine := 0;
  109.         // Find line number information
  110.         while Count > 0 do
  111.         begin
  112.           P1 := DecodeLineNumber(P1, Delta1, Delta2, liFileName);
  113.           if Delta1 = MaxInt then
  114.             begin
  115.               CurLine := 0;     // New file
  116.               CurOfs := 0;
  117.             end
  118.           else
  119.             begin
  120.               liLineOfs := CurOfs + Delta2;
  121.               if (liLineOfs + Integer(OfsDelta) >= liUnitBegOfs) and (liLineOfs + Integer(OfsDelta) < liUnitEndOfs) and (CodeOfs < DWORD(liLineOfs)) then
  122.               begin
  123.                 if CurLine = 0 then
  124.                   begin
  125.                     liLineOfs := 0;
  126.                     liLineNo := 0;
  127.                   end
  128.                 else
  129.                   begin
  130.                     liLineNo  := CurLine;
  131.                     liLineOfs := CurOfs + Integer(OfsDelta);
  132.                   end;
  133.                 Exit;
  134.               end;
  135.               Inc(CurLine, Delta1);
  136.               Inc(CurOfs , Delta2);
  137.               Dec(Count);
  138.             end;
  139.         end;
  140.         liFileName := '';
  141.         liLineNo  := 0;
  142.         liLineOfs := 0;
  143.       end;
  144.     end;
  145. end;
  146.  
  147. initialization
  148.   RTLIResInfo := FindResource(HInstance, PChar($7777), RT_RCDATA);
  149.   if RTLIResInfo <> 0 then
  150.   begin
  151.     RTLIResource := LoadResource(HInstance, RTLIResInfo);
  152.     if RTLIResource <> 0 then
  153.       RTLIResPtr := LockResource(RTLIResource);
  154.   end;
  155.  
  156. finalization
  157.   UnlockResource(RTLIResource);
  158.   FreeResource(RTLIResInfo);
  159. end.
  160.